home *** CD-ROM | disk | FTP | other *** search
/ Nebula 1 / Nebula One.iso / Internet / WWW / Perl_WWW_Utilities / perlMIF_beta2 / mif / mif_conc.pl < prev    next >
Encoding:
Perl Script  |  1994-05-18  |  7.3 KB  |  233 lines
  1. ##---------------------------------------------------------------------------##
  2. ##  File:
  3. ##      mif_conc.pl
  4. ##  Author:
  5. ##      Earl Hood       ehood@convex.com
  6. ##  Description:
  7. ##    This file is defines the "mif_conc" perl package.  It defines
  8. ##    routines to handle the ConditionCatalog via MIFread_mif() defined in
  9. ##    the "mif" package.
  10. ##---------------------------------------------------------------------------##
  11. ##  Copyright (C) 1994  Earl Hood, ehood@convex.com
  12. ##
  13. ##  This program is free software; you can redistribute it and/or modify
  14. ##  it under the terms of the GNU General Public License as published by
  15. ##  the Free Software Foundation; either version 2 of the License, or
  16. ##  (at your option) any later version.
  17. ## 
  18. ##  This program is distributed in the hope that it will be useful,
  19. ##  but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21. ##  GNU General Public License for more details.
  22. ##  
  23. ##  You should have received a copy of the GNU General Public License
  24. ##  along with this program; if not, write to the Free Software
  25. ##  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  26. ##---------------------------------------------------------------------------##
  27.  
  28. require 'mif/mif.pl' || die "Unable to require mif.pl\n";
  29.  
  30. package mif_conc;
  31.  
  32. ##--------------------------------------------------##
  33. ## Add ConditionCatalog function to %MIFToken array ##
  34. ##--------------------------------------------------##
  35. $mif'MIFToken{'ConditionCatalog'} = 'ConditionCatalog';
  36.  
  37. ##-------------------------------------##
  38. ## ConditionCatalog associative arrays ##
  39. ##-------------------------------------##
  40. %CState        = ();
  41. %CStyle        = ();
  42. %CColor        = ();    # Frame 4.x
  43. %CSeparation    = ();    # Frame 3.x
  44.  
  45. ##--------------------------------------------##
  46. ## Variables for current Condition definition ##
  47. ##--------------------------------------------##
  48. $cc_Color    = "";
  49. $cc_Separation    = "";
  50. $cc_State    = "";
  51. $cc_Style    = "";
  52. $cc_Tag        = "";
  53.  
  54. ##------------------------##
  55. ## Import 'mif' variables ##
  56. ##------------------------##
  57. $MStore        = $mif'MStore;
  58. $MOpen        = $mif'MOpen;
  59. $MClose        = $mif'MClose;
  60. $MLine        = $mif'MLine;
  61. $mso        = $mif'mso;
  62. $msc        = $mif'msc;
  63. $stb        = $mif'stb;
  64. $ste        = $mif'ste;
  65. $como        = $mif'como;
  66.  
  67.                 ##---------------##
  68.                 ## Main Routines ##
  69.                 ##---------------##
  70. ##---------------------------------------------------------------------------
  71. ##    MIFwrite_conc() outputs the ConditionCatalog as defined by the
  72. ##    associative arrays.
  73. ##
  74. ##    Usage:
  75. ##        &'MIFwrite_conc(FILEHANDLE);
  76. ##
  77. sub main'MIFwrite_conc {
  78.     local($handle, $l) = @_;
  79.     local($i0, $i1, $i2) = (' ' x $l, ' ' x (1+$l), ' ' x (2+$l));
  80.  
  81.     print $handle $i0, $mso, 'ConditionCatalog', "\n";
  82.     foreach (sort keys %CState) {
  83.     print $handle $i1, $mso, "Condition\n";
  84.     print $handle $i2, $mso, 'CTag ', $stb, $_, $ste, $msc, "\n";
  85.     print $handle $i2, $mso, 'CState ', $CState{$_}, $msc, "\n";
  86.     print $handle $i2, $mso, 'CStyle ', $CStyle{$_}, $msc, "\n";
  87.     print $handle $i2, $mso, 'CSeparation ', $CSeparation{$_}, $msc, "\n"
  88.         if $CSeparation{$_} ne "";
  89.     print $handle $i2, $mso, 'CColor ', $stb, $CColor{$_}, $ste, $msc, "\n"
  90.         if $CColor{$_} ne "";
  91.     print $handle $i1, $msc, " $como end of Condition\n";
  92.     }
  93.     print $handle $i0, $msc, " $como end of ConditionCatalog\n";
  94. }
  95. ##---------------------------------------------------------------------------##
  96. ##    MIFget_condition_data() is a convienence routine that returns
  97. ##    the data associated with a Frame condition.
  98. ##
  99. ##    Usage:
  100. ##        ($state, $style, $color, $sep) =
  101. ##        &'MIFget_condition_data($condition);
  102. ##
  103. sub main'MIFget_condition_data {
  104.     local($condition) = @_;
  105.     ($CState{$condition},
  106.      $CStyle{$condition}, 
  107.      $CColor{$condition}, 
  108.      $CSeparation{$condition});
  109. }
  110. ##---------------------------------------------------------------------------##
  111. ##      MIFget_conditions() returns a sorted array of all condition names
  112. ##    defined in the condition catalog.
  113. ##
  114. ##      Usage:
  115. ##          @conditions = &'MIFget_conditions();
  116. ##
  117. sub main'MIFget_conditions {
  118.     return sort keys %CState;
  119. }
  120. ##---------------------------------------------------------------------------##
  121. ##    MIFreset_conc() resets the associative arrays for the condition
  122. ##    catalog.
  123. ##
  124. ##    Usage:
  125. ##        &'MIFreset_conc();
  126. ##
  127. sub main'MIFreset_conc {
  128.     undef %CState;
  129.     undef %CStyle;
  130.     undef %CColor;
  131.     undef %CSeparation;
  132. }
  133. ##---------------------------------------------------------------------------##
  134.                 ##--------------##
  135.                 ## Mif Routines ##
  136.                 ##--------------##
  137. ##---------------------------------------------------------------------------##
  138. ##    The routines definded below are all registered in the %MIFToken         ##
  139. ##    array for use in the read_mif() routine.  There purpose is to         ##
  140. ##    store the information contained in the condition catalog.         ##
  141. ##---------------------------------------------------------------------------##
  142.  
  143. ##---------------------------------------------------------------------------
  144. ##    ConditionCatalog() is the token routine for 'ConditionCatalog'.
  145. ##    It sets/restores token routines depending upon mode.
  146. ##
  147. sub mif'ConditionCatalog {
  148.     local($token, $mode, *data) = @_;
  149.     if ($mode == $MOpen) {
  150.     ($_fast, $_noidata) = ($mif'fast, $mif'no_import_data);
  151.     ($mif'fast, $mif'no_import_data) = (1, 1);
  152.     @_conc_orgfunc = @mif'MIFToken{
  153.                 'Condition',
  154.                 'CTag',
  155.                 'CState',
  156.                 'CStyle',
  157.                 'CColor',
  158.                 'CSeparation'
  159.             };
  160.     @mif'MIFToken{
  161.         'Condition',
  162.         'CTag',
  163.         'CState',
  164.         'CStyle',
  165.         'CColor',
  166.         'CSeparation'
  167.     } = (
  168.         "mif_conc'Condition",
  169.         "mif_conc'CTag",
  170.         "mif_conc'CState",
  171.         "mif_conc'CStyle",
  172.         "mif_conc'CColor",
  173.         "mif_conc'CSeparation"
  174.     );
  175.     } elsif ($mode == $MClose) {
  176.     @mif'MIFToken{
  177.         'Condition',
  178.         'CTag',
  179.         'CState',
  180.         'CStyle',
  181.         'CColor',
  182.         'CSeparation'
  183.     } = @_conc_orgfunc;
  184.         ($mif'fast, $mif'no_import_data) = ($_fast, $_noidata);
  185.     }
  186. }
  187. ##---------------------------------------------------------------------------
  188. sub Condition {
  189.     local($token, $mode, *data) = @_;
  190.  
  191.     if ($mode == $MOpen) {
  192.     $cc_Color = "";
  193.     $cc_Separation = "";
  194.     $cc_State = "";
  195.     $cc_Style = "";
  196.     $cc_Tag     = "";
  197.     } elsif ($mode == $MClose) {
  198.     $CState{$cc_Tag} = $cc_State;
  199.     $CStyle{$cc_Tag} = $cc_Style;
  200.     $CColor{$cc_Tag} = $cc_Color;
  201.     $CSeparation{$cc_Tag} = $cc_Separation;
  202.     } else {
  203.     warn "Unexpected mode, $mode, passed to Condition routine\n";
  204.     }
  205. }
  206. ##---------------------------------------------------------------------------
  207. sub CTag {
  208.     local($token, $mode, *data) = @_;
  209.     ($cc_Tag) = $data =~ /^\s*$stb([^$ste]*)$ste\s*$/o;
  210. }
  211. ##---------------------------------------------------------------------------
  212. sub CState {
  213.     local($token, $mode, *data) = @_;
  214.     ($cc_State) = $data =~ /^\s*(.*)$/o;
  215. }
  216. ##---------------------------------------------------------------------------
  217. sub CStyle {
  218.     local($token, $mode, *data) = @_;
  219.     ($cc_Style) = $data =~ /^\s*(.*)$/o;
  220. }
  221. ##---------------------------------------------------------------------------
  222. sub CSeparation {
  223.     local($token, $mode, *data) = @_;
  224.     ($cc_Separation) = $data =~ /^\s*(.*)$/o;
  225. }
  226. ##---------------------------------------------------------------------------
  227. sub CColor {
  228.     local($token, $mode, *data) = @_;
  229.     ($cc_Color) = $data =~ /^\s*$stb([^$ste]*)$ste\s*$/o;
  230. }
  231. ##---------------------------------------------------------------------------
  232. 1;
  233.